home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tclm_1_0.lha / tclm-1.0 / minfo < prev    next >
Text File  |  1993-08-16  |  6KB  |  175 lines
  1. #!/usr/local/bin/tclm -f
  2. #
  3. # Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  4. #
  5. # Redistribution and use in source and binary forms, with or without
  6. # modification, are permitted provided that the following conditions
  7. # are met:
  8. # 1. Redistributions of source code must retain the above copyright
  9. #    notice, this list of conditions and the following disclaimer.
  10. # 2. Redistributions in binary form must reproduce the above copyright
  11. #    notice, this list of conditions and the following disclaimer in the
  12. #    documentation and/or other materials provided with the distribution.
  13. # 3. All advertising materials mentioning features or use of this software
  14. #    must display the following acknowledgement:
  15. #    This product includes software developed by Michael B. Durian.
  16. # 4. The name of the the Author may be used to endorse or promote 
  17. #    products derived from this software without specific prior written 
  18. #    permission.
  19. #
  20. # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  21. # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  22. # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  23. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  24. # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31. #
  32.  
  33. # minfo,v 1.6 1993/04/08 04:16:01 durian Exp
  34.  
  35. # get filename arg
  36. if {[string compare [lindex $argv 0] "-f"] == 0} {
  37.     set midi_file_name [lindex $argv 2]
  38. } else {
  39.     set midi_file_name [lindex $argv 0]
  40. }
  41.  
  42. proc FormatEvent {event} {
  43.     global pos
  44.  
  45.     # get the timing part of the event
  46.     set timing [lindex $event 0]
  47.  
  48.     # determine offset from start of track
  49.     set pos [expr {$timing + $pos}]
  50.     set out [format "%6d: " $pos]
  51.  
  52.     case [lindex $event 1] in {
  53.     noteoff {
  54.         set chan [lindex $event 2]
  55.         set pitch [lindex $event 3]
  56.         set vel [lindex $event 4]
  57.         append out "NOTEOFF channel $chan pitch $pitch velocity $vel"
  58.     } noteon {
  59.         set chan [lindex $event 2]
  60.         set pitch [lindex $event 3]
  61.         set vel [lindex $event 4]
  62.         append out "NOTEON channel $chan pitch $pitch velocity $vel"
  63.     } keypressure {
  64.         set chan [lindex $event 2]
  65.         set pitch [lindex $event 3]
  66.         set pres [lindex $event 4]
  67.         append out \
  68.             "KEY PRESSURE channel $chan pitch $pitch pressure $pres"
  69.     } parameter {
  70.         set chan [lindex $event 2]
  71.         set param [lindex $event 3]
  72.         set set [lindex $event 4]
  73.         append out \
  74.             "PARAMETER channel $chan parameter $param setting $set"
  75.     } program {
  76.         set chan [lindex $event 2]
  77.         set prog [lindex $event 3]
  78.         append out "PROGRAM channel $chan program $prog"
  79.     } channelpressure {
  80.         set chan [lindex $event 2]
  81.         set pres [lindex $event 3]
  82.         append out "CHANNEL PRESSURE channel $chan pressure $pres"
  83.     } pitchwheel {
  84.         set chan [lindex $event 2]
  85.         set val [lindex $event 3]
  86.         append out "PITCH WHEEL channel $chan value $val"
  87.     } metachanprefix {
  88.         append out "METACHANPREFIX [lindex $event 2]"
  89.     } metacpy {
  90.         append out "METACPY [lindex $event 2]"
  91.     } metacue {
  92.         append out "METACUE [lindex $event 2]"
  93.     } metaeot {
  94.         append out "METAEOT"
  95.     } metainstname {
  96.         append out "METAINSTNAME [lindex $event 2]"
  97.     } metakey {
  98.         append out "METAKEY [lindex $event 2] [lindex $event 3]"
  99.     } metalyric {
  100.         append out "METALYRIC [lindex $event 2]"
  101.     } metamarker {
  102.         append out "METAMARKER [lindex $event 2]"
  103.     } metaseqname {
  104.         append out "METASEQNAME [lindex $event 2]"
  105.     } metaseqnum {
  106.         append out "METASEQNUM [lindex $event 2]"
  107.     } metaseqspec {
  108.         append out "METASEQSPEC"
  109.     } metasmpte {
  110.         set hr [lindex $event 2]
  111.         set mi [lindex $event 3]
  112.         set se [lindex $event 4]
  113.         set fr [lindex $event 5]
  114.         set ff [lindex $event 6]
  115.         append out \
  116.             "METASMPTE Hour $hr, Min. $mi, Sec. $se, Frame $fr, Frac. Frame $ff"
  117.     } metatempo {
  118.         append out "METATEMPO [lindex $event 2] BPM"
  119.     } metatext {
  120.         append out "METATEXT [lindex $event 2]"
  121.     } metatime {
  122.         set num [lindex $event 2]
  123.         set den [lindex $event 3]
  124.         set cpm [lindex $event 4]
  125.         set _32 [lindex $event 5]
  126.         append out \
  127.             "METATIME $num/$den, $cpm clocks per met. beat, $_32 32nd notes per 1/4 note"
  128.     } sysex {
  129.         append out "SYSEX [lindex $event 2]"
  130.         if {[llength $event] > 3} {
  131.             append out " [lindex $event 3]"
  132.         }
  133.     }
  134.     }
  135.  
  136.     return $out
  137. }
  138.  
  139. if {[string length $midi_file_name] == 0} {
  140.     # if no filename is specified use stdin
  141.     set midi_file stdin
  142.     set midi_file_name stdin
  143. } else {
  144.     # check to see if the specified file exists and open it
  145.     if {![file exists $midi_file_name]} then {
  146.         puts stderr "Bad file name: $midi_file_name"
  147.         exit 1
  148.     } else {
  149.         set midi_file [open $midi_file_name]
  150.     }
  151. }
  152.  
  153. # read the midi file
  154. # print out error if there is one
  155. if {[catch {midiread $midi_file} mfile]} {
  156.     puts stderr $mfile
  157.     exit 1
  158. }
  159. puts stdout [format "%-16s = %s" "file name" $midi_file_name]
  160. puts stdout [format "%-16s = %s" "format" [midiconfig $mfile format]]
  161. puts stdout [format "%-16s = %s" "division" [midiconfig $mfile division]]
  162. set num_trks [midiconfig $mfile tracks]
  163. puts stdout [format "%-16s = %s" "number of tracks" $num_trks]
  164.  
  165. # print out all the tracks
  166. for {set track 0} {$track < $num_trks} {incr track} {
  167.     puts stdout "\nTrack $track"
  168.     set pos 0
  169.     while {[string compare [set event [midiget $mfile $track]] EOT] != 0} {
  170.         set out [FormatEvent $event]
  171.         puts stdout $out
  172.     }
  173. }
  174. exit 0
  175.